home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Software Vault: The Gold Collection
/
Software Vault - The Gold Collection (American Databankers) (1993).ISO
/
cdr49
/
135_01.zip
/
MATH.CSM
< prev
next >
Wrap
Text File
|
1993-06-10
|
21KB
|
1,458 lines
;
; MATH.CSM---a high precision (2^2048) integer math package.
; This version based on the package written by M. G. Dinneley,
; published in the March 1977 issue of Dr Dobb's Journal. It
; has been adapted by Thomas Hill for m80 and CP/M. Further
; corrections, additions and adaptions for BDSc by Hugh S. Myers.
;
; M. G. Dinneley
; 3/77
;
; Thomas Hill
; 8/10/82
;
; Hugh S. Myers
; 9/30/83
; 4/2/84
;
INCLUDE <BDS.LIB>
;
; AD1---SIGNED ADDITION.
;
FUNCTION AD1
EXTERNAL GPAS1
XRA A ;CLEAR CARRY
JMP GPAS1
ENDFUNC
;
; SB1---SIGNED SUBTRACTION.
;
FUNCTION SB1
EXTERNAL GPAS1
STC ;SET CARRY
JMP GPAS1
ENDFUNC
;
; GPAS1---GENERAL PURPOSE ADD & SUBTRACT (SIGNED).
;
FUNCTION GPAS1
EXTERNAL ADD1,SUB1
PUSH PSW ;SAVE FLAGS
LDAX D
XRA M ;DIFFERING SIGNS?
JM GPAS3
POP PSW ;NO
JC GPAS4 ;GO DO SUBTRACTION
GPAS2:
CALL ADD1 ;ELSE DO ADDITION.
RET
GPAS3:
POP PSW
JC GPAS2 ;DIFFERING SIGNS, IF SUBTRACT (CARRY SET) THEN
;DO ADDITION RATHER THAN SUBTRACTION.
GPAS4:
CALL SUB1
RET
ENDFUNC
;
; ADD1---SIMPLE POSITIVE ADDITION, ADDS (HL) TO (DE) LEAVING
; RESULT AT (DE).
;
FUNCTION ADD1
EXTERNAL LDC2,LDB1,INRM
CALL LDC2 ;GET LENGTH OF (HL) TO C
PUSH D
PUSH H
CALL LDB1 ;GET LENGTH OF (DE) TO B
SUB C ;COMPARE LENGTHS
XCHG
JNC ADD2
CMA ;INCREASE AUGEND LENGTH TO
;EQUAL LENGTH OF ADDEND
ADC M
MOV M,A
XRA A ;CLEAR ACCUMULATOR
ADD B ;LENGTH OF (DE)
JZ ADD5 ;AUGEND IS ZERO, DON'T ADD
ADD2:
INX H
INX D
LDAX D ;GET AUGEND BYTE
ADC M ;AND ADD IT TO ADDEND PLUS CARRY IF ANY
MOV M,A
DCR B
JZ ADD6 ;NO MORE AUGEND LEFT TO ADD
DCR C
JNZ ADD2 ;CONTINUE ADDITION
ADD3:
INX H ;ADDEND EXHAUSTED
MOV A,M
ADC C
MOV M,A
DCR B ;CONTINUE BY ADDING ZEROS TO AUGEND
;UNTIL AUGEND EXHAUSTED
JNZ ADD3
JNC ADD7 ;FINISHED
ADD4:
INX H ;OVERFLOW
MVI M,1 ;EXTEND RESULT BY CARRY TO NEW DIGIT
;POSITION
POP D
POP H
CALL INRM ;EXTEND LENGTH BYTE BY ONE
XCHG
RET
ADD5:
INX H
INX D
LDAX D
ADC B
MOV M,A
ADD6:
DCR C ;ADD ZERO TO ADDEND
JNZ ADD5
JC ADD4 ;FINISHED, CHECK FOR OVERFLOWS
ADD7:
POP H
POP D
RET
ENDFUNC
;
; SUB1---SIMPLE UNSIGNED SUBTRACTION ROUTINE, SUB1 SUBTRACTS
; (HL) FROM (DE) LEAVING THE RESULT AT (DE).
;
FUNCTION SUB1
EXTERNAL LDC2,LDB1,DCRM
CALL LDC2
PUSH H
PUSH D
CALL LDB1 ;GET LENGTHS
SUB C ;COMPARE THEM.
JNC SUB2
XCHG
CMA
ADC M ;INCREASE MINUEND
;LENGTH (PRESERVE SIGN)
MOV M,A
XRA A
ADD B
XCHG
JZ SUB3 ;MINUEND EQUALS ZERO
SUB2:
INX H
INX D
LDAX D
SBB M ;DO THE SUBTRACTION HERE
STAX D
DCR C
JZ SUB7 ;JUMP IF SUBTRAHEND EXHAUSTED
DCR B
JNZ SUB2
SUB3:
INX H ;IF HERE THEN MINUEND EXHAUSTED
INX D
MOV A,B
SBB M ;SUBTRACT ZEROS
STAX D
DCR C
JNZ SUB3 ;CONTINUE UNTIL DONE
SUB4:
POP H
PUSH H ;IF RESULT IS NEGATIVE, FORM TWO'S
;COMPLIMENT.
PUSH D
MOV A,M
RAL
CMC
RAR
MOV M,A
ANI 7FH
MOV C,A ;LENGTH TO C
STC
SUB5:
INX H
MOV A,M
CMA
ADC B
MOV M,A
DCR C
JNZ SUB5
POP D
JMP SUB8
SUB6:
INX D
LDAX D
SBB C
STAX D
SUB7:
DCR B
JNZ SUB6
JC SUB4
SUB8:
POP H
SUB9:
LDAX D
CMP C ;ANY REDUCTION IN PRECISION?
JNZ SUB11 ;NOPE.
DCX D
SUB10:
CALL DCRM ;REDUCE PRECISION
JNZ SUB9
SUB11:
XCHG
POP H
RET
ENDFUNC
;
; MULT---GENERAL PURPOSE MULTIPLY ROUTINE. MULTIPLIES (DE) BY (HL)
; WITH RESULT STORED AT (DE). THIS ROUTINE HANDLES BOTH NEGATIVE AND
; AND POSITIVE VALUES. NOTE...THIS VERSION HAS BEEN PATCHED TO ALLOW
; (DE) AND (HL) TO POINT AT THE SAME INITIAL NUMBER.
;
FUNCTION MULT
EXTERNAL LDB2,MOOV,LEFT,RIGHT,ADD1
CALL LDB2
PUSH H
LDAX D
XRA M ;CHECK SIGNS
PUSH PSW ;SAVE RESULT
PUSH D
PUSH H
LXI H,T1
CALL MOOV ;PUT MULTIPLICAND IN T1 WORK AREA
POP D
LXI H,T2
CALL MOOV ;PUT MULTIPLIER IN T2 WORK AREA
POP D
XRA A
STAX D ;SET RESULT TO ZERO FOR START
MULT1:
LXI H,T2
MOV A,M ;START MULTIPLICATION
ORA A
JZ MULT3 ;FINISHED
CALL RIGHT
LXI H,T1
JNC MULT2 ;LEAST SIGNIFICANT BIT NOT SET, SO DON'T
;ADD
CALL ADD1
MULT2:
CALL LEFT ;LEFT SHIFT MULTIPLICAND
JMP MULT1
MULT3:
POP PSW
POP H
RP ;IF PLUS THEN NO SIGN DIFFERENCE
LDAX D
XRI 80H ;CHANGE SIGN
STAX D
RET
T1: DS 128
T2: DS 128
ENDFUNC
;
; MODULUS---GENERAL PURPOSE MODULO ROUTINE.
; DIVIDES (DE) BY (HL) WITH REMAINDER TO (DE).
;
FUNCTION MODULUS
EXTERNAL DDIV
XRA A
ADI 80H ;CLEAR CARRY AND SET SIGN BIT
JMP DDIV
ENDFUNC
;
; DIVR---DIVIDE AND ROUND. DIVIDES (DE) BY (HL) WITH RESULT TO (DE)
; AFTER ROUNDING.
;
FUNCTION DIVR
EXTERNAL DDIV
XRA A
STC ;SET CARRY AND CLEAR SIGN
JMP DDIV
ENDFUNC
;
; DIV---DIVIDE ROUTINE. DIVIDES (DE) BY (HL) WITH RESULT TO (DE).
;
FUNCTION DIV
EXTERNAL DDIV
XRA A ;CLEAR CARRY AND CLEAR SIGN
JMP DDIV
ENDFUNC
;
; DDIV---GENERAL PURPOSE WORKHORSE FOR DIV, MODULUS AND DIVR.
;
FUNCTION DDIV
EXTERNAL LDC1,LDB1,MOOV,PSHL,SUB1,INCR,RIGHT
EXTERNAL LEFT,PARE
PUSH H
PUSH PSW ;SAVE VECTOR FLAGS
LDAX D
XRA M ;SIGN DIFFERENCE?
RLC
JNC DDIV2 ;NO SIGN DIFFERENCES
POP PSW
INR A ;SIGN DIFFERENCE IN BIT 0
PUSH PSW
DDIV2:
CALL LDC1 ;GET LENGTH OF DIVISOR
JZ RETN ;BAIL OUT IF DIVISOR IS ZERO
CALL LDB1
SUB C
JM RETN ;DIVISOR IS GREATER THAN DIVIDEND
PUSH D
INR A
MOV B,A
MOV C,A ;SAVE LENGTH DIFFERENCE
PUSH B
LDAX D
ANI 7FH ;CLEAR SIGN OF DIVIDEND
STAX D
MOV A,M
ANI 7FH ;CLEAR SIGN OF PARTIAL DIVISOR
MOV M,A
XCHG
LXI H,T1 ;SET TO T1
CALL MOOV ;MOVE DIVISOR FROM (DE) TO T1 (HL)
XRA A
STA T2 ;ZERO OUT DIVIDEND (T2)
POP D
DDIV3:
CALL PSHL
DCR E
JNZ DDIV3
MOV C,A
MOV B,D
DDIV4:
POP D
PUSH D
PUSH B
LXI H,T1
CALL PARE ;PARTIAL DIVIDEND >= PARTIAL DIVISOR?
JC DDIV5 ;NO
CALL SUB1 ;YES, SUBTRACT
LXI H,T2
CALL INCR ;INCREMENT QUOTIENT
DDIV5:
LXI H,T1
CALL RIGHT ;RIGHT SHIFT PARTIAL DIVISOR
POP B
DCR C ;LOOP COUNT
JP DDIV6
MVI C,7
DCR B
JM DDIV7 ;END
DDIV6:
PUSH B
LXI H,T2
CALL LEFT ;LEFT SHIFT PARTIAL RESULT
POP B
JMP DDIV4 ;CONTINUE DIVISION
DDIV7:
POP D
POP PSW ;(DE)-> REMAINDER
JM DDIV11 ;MODULO FUNCTION
JNC DDIV9 ;NO ROUNDING
PUSH PSW
CALL PARE ;PARTIAL DIVISOR/2 < REMAINDER?
JC DDIV8
JZ DDIV8 ;NO
LXI H,T2
CALL INCR ;YES, INCREMENT ANSWER FOR ROUNDING
DDIV8:
POP PSW
DDIV9:
XCHG
LXI D,T2
ANI 1
JZ DDIV10 ;NO CHANGE OF SIGN
LDAX D
ORI 80H ;CHANGE SIGN
STAX D
DDIV10:
CALL MOOV ;MOVE RESULT TO (DE)
XCHG
DDIV11:
XRA A
POP H
LXI H,T2 ;(DE)-> MODULUS, (HL)->QUOTIENT
RET
RETN:
POP PSW
STC ;CARRY SET INDICATES NO
;DIVISION
POP H
RET
T1: DS 128
T2: DS 128
ENDFUNC
;
; SQRTR---SQUARE ROOT ROUNDED OF (DE).
; RETURNS RESULT AT (DE).
;
FUNCTION SQRTR
EXTERNAL SQRT1
ORA A ;CLEAR CARRY FOR ROUNDING
JMP SQRT1
ENDFUNC
;
; SQRT---SQUARE ROOT OF (DE) RETURNED AT (DE).
;
FUNCTION SQRT
EXTERNAL SQRT1
STC ;SET CARRY FOR NO ROUNDING
JMP SQRT1
ENDFUNC
;
; SQRT1---WORKHORSE FOR SQRT AND SQRTR.
;
FUNCTION SQRT1
EXTERNAL PSHL,ADD1,PARE,SUB1,RIGHT,INCR,MOOV
PUSH PSW ;SAVE OPERATION TYPE
LDAX D
ORA A
STC
JP SQRT2
POP B
RET ;RETURN NO OP IF NEGATIVE OR ZERO
SQRT2:
MVI C,1
LXI H,T2
MOV M,C
INX H
MOV M,C ;INITIALIZE T2 TO 1
PUSH D
MOV D,A
MVI A,0
DCX H
SQRT3:
CALL PSHL
DCR D ;MAKE T2 >N (T2 MUST BE A SQUARE NUMBER)
JNZ SQRT3
LXI D,T1
STAX D ;CLEAR T1
SQRT4:
CALL ADD1 ;T1 = T1 + T2
XCHG
POP D
CALL PARE ;N >= T1?
PUSH PSW
CNC SUB1 ;YES, N = N -T1
POP PSW
PUSH D
XCHG
LXI H,T2
PUSH PSW
CNC ADD1 ;YES, T1 = T1 + T2
POP PSW
CC SUB1 ;NO, T1 = T1 - T2
XCHG
CALL RIGHT ;T1 = T1 / 2
XCHG
CALL RIGHT
CALL RIGHT ;T2 = T2 / 4
MOV A,M
ORA A ;T2 = ZERO?
JNZ SQRT4 ;NO
POP H
POP PSW ;WAS IT ROUND?
JC SQRT5 ;NO
CALL PARE ;N > T1?
JNC SQRT5
XCHG
CALL INCR ;YES SO T1 = T1 + 1
XCHG
SQRT5:
CALL MOOV ;PUT RESULT BACK TO (DE)
XCHG
ORA A ;CLEAR CARRY FOR GOOD RESULT
RET
T1: DS 128
T2: DS 128
ENDFUNC
;
; FACT---COMPUTE THE FACTORIAL OF (HL) AND RETURN
; RESULT AT (HL).
;
FUNCTION FACT
EXTERNAL MOOV,DECR,MULT
MOV A,M
ANI 7FH ;N=ABS(N).
MOV M,A
ORA A
RZ ;F(0)=0 SO RETURN IF ZERO.
CPI 1 ;CHECK FOR SPECIAL CASE OF N=1
;AND N=2.
JNZ FAC1
INX H
MOV A,M
DCX H
CPI 1
RZ ;F(1)=1 SO RETURN ONE.
CPI 2
RZ ;F(2)=2 SO RETURN TWO.
FAC1:
PUSH D ;SAVE DE FOR RETURN.
XCHG
LXI H,FVAR
CALL MOOV ;FVAR=N.
CALL DECR ;FVAR=FVAR-1.
FAC2:
CALL MULT ;N=N*FVAR.
CALL DECR ;FVAR=FVAR-1.
MOV A,M
CPI 1
JNZ FAC2
INX H
MOV A,M
DCX H
CPI 1 ;DECREASE FVAR TO 1 STEP -1.
JNZ FAC2
XCHG ;(HL)->N!, (DE)->FVAR.
POP D ;RESTORE D.
RET
FVAR: DS 128
ENDFUNC
;
; POW---GIVEN (HL)=X AND (DE)=N, RETURN P(X,N) AT (DE), WHERE
; N IS A POSITIVE INTEGER. THIS ROUTINE USES ALGORITHM A, PAGE
; 442 OF SEMINUMERICAL ALGORITHMS, BY D. KNUTH.
;
FUNCTION POW
EXTERNAL MOOV,RIGHT,MULT
PUSH H ;SAVE FOR ALL RETURNS.
PUSH D ;SAVE FOR ALL RETURNS.
XRA A
STA PNEG ;CLEAR NEGATIVE RETURN FLAG.
MOV A,M
ORA A
JZ RET0 ;P(0,N)=0.
ANI 80 ;IS X <0?
JZ POW0 ;NO.
INX D
LDAX D ;GET N.
DCX D
ANI 1 ;IS N ODD OR EVEN?
JZ POW0 ;N IS EVEN SO SKIP.
STA PNEG ;SET SIGN FOR RETURN.
POW0:
MOV A,M
ANI 7FH ;IGNORE SIGN FOR NOW.
CPI 1
JNZ POW1
INX H
MOV A,M
DCX H
CPI 1
JZ RET1 ;P(1,N)=1.
POW1:
XCHG
MOV A,M
ANI 7FH ;N=ABS(N).
MOV M,A
ORA A
JZ RET1 ;P(X,0)=1.
CPI 1
JNZ POW2
INX H
MOV A,M
DCX H
CPI 1
JZ RETX ;P(X,1)=X.
POW2:
PUSH H
LXI H,Y
MVI M,1
INX H
MVI M,1 ;Y=1.
LXI H,Z
CALL MOOV ;Z=X.
POP H
POW3:
INX H
MOV A,M
DCX H
ANI 1
PUSH PSW ;TEST FOR ODD/EVEN AND SAVE RESULT.
CALL RIGHT ;SHIFT RIGHT ONE BIT, N=N/2.
POP PSW
JZ POW4 ;SEE STEP A2...POW4 CORRESPONDS TO A5.
PUSH H
PUSH D
LXI D,Y
LXI H,Z
CALL MULT
POP D
POP H
MOV A,M
ORA A
JZ RETY
POW4:
PUSH H
PUSH D
LXI D,Z
LXI H,Z
CALL MULT
POP D
POP H
JMP POW3
RET0:
POP D
POP H
MVI A,0
STAX D
RET
RET1:
POP D
POP H
MVI A,1
STAX D
INX D
STAX D
DCX D
RET
RETX:
POP D
POP H
XCHG
CALL MOOV
XCHG
RET
RETY:
LDA PNEG
ORA A
JZ RETY1
LDA Y
XRI 80H
STA Y
RETY1:
POP D
XCHG
LXI D,Y
CALL MOOV
POP H
RET
PNEG: DB 0
Y: DS 128
Z: DS 128
ENDFUNC
;
; GCD---GIVEN (DE)=A AND (HL)=B, RETURN THE GREATEST COMMON
; DIVISOR AT (DE).
;
FUNCTION GCD
EXTERNAL MOOV,DIV,MULT,SB1
MOV B,M
LDAX D
ORA B
RZ ;BOTH ARE ZERO.
MOV A,M
ANI 7FH
MOV M,A ;B=ABS(B).
LDAX D
ANI 7FH
STAX D ;A=ABS(A).
GCD1:
PUSH H
LXI H,R
CALL MOOV ;R=A.
POP H
PUSH H ;SAVE BECAUSE DIV RETURNS QUOTIENT IN HL
CALL DIV ;A=A\B.
POP H
CALL MULT ;A=A*B.
XCHG ;HL=A, DE=B.
PUSH D
LXI D,R
CALL SB1 ;R=R-A.
POP D
LDA R
ORA A
JZ RETB ;IF R=0 THEN RETURN B.
CALL MOOV ;A=B.
XCHG ;HL=B, DE=A.
PUSH D
LXI D,R
CALL MOOV ;B=R.
POP D
JMP GCD1
RETB:
CALL MOOV ;A=B.
XCHG ;HL=B, DE=A.
RET
R: DS 128
ENDFUNC
;
; LCM---GIVEN (DE)=A AND (HL)=B, RETURN THE LEAST COMMON MULTIPLE
; OF A AND B AT (DE). LCM(A,B)=A*B/GCD(A,B).
;
FUNCTION LCM
EXTERNAL MOOV,MULT,GCD,DIV
MOV B,M
LDAX D
ORA B
RZ ;BOTH ARE ZERO.
MOV A,M
ANI 7FH
MOV M,A ;B=ABS(B).
LDAX D
ANI 7FH
STAX D ;A=ABS(A).
PUSH H
LXI H,LCMV
CALL MOOV ;LCMV=A.
POP H
PUSH D
LXI D,LCMV
CALL MULT ;LCMV=LCMV*B.
POP D
CALL GCD ;A=GCD(A,B)
PUSH H
XCHG
LXI D,LCMV
CALL DIV
CALL MOOV
XCHG
POP H
RET
LCMV: DS 128
ENDFUNC
;
; RAND---RANDOM NUMBER GENERATOR. IF HL=0 THEN RETURN R(N) ELSE
; RETURN R(1). NUMBER IS RETURNED AT (DE).
;
FUNCTION RAND
EXTERNAL AD1,MOOV,MULT,MODULUS
MOV A,H
ORA L
JZ RAND1
LXI H,XN
MVI M,1
INX H
MVI M,1
RAND1:
PUSH D
LXI D,XN
LXI H,RMULT
CALL MULT
CALL AD1
LXI H,RMOD
PUSH H
CALL MODULUS
POP H
POP D
XCHG
LXI D,XN
CALL MOOV
XCHG
RET
XN: DS 128
RMULT: DB 3,1,0,1
RMOD: DB 10H,0FFH,0FFH,0FFH,0FFH
DB 0FFH,0FFH,0FFH,0FFH
DB 0FFH,0FFH,0FFH,0FFH
DB 0FFH,0FFH,0FFH,7FH
ENDFUNC
;
; AUXILLIARY ROUTINES
;
;
; LDB1---LOADS REGISTER B WITH LENGTH INDICATOR OF VALUE AT (DE).
;
FUNCTION LDB1
LDAX D
RAL
ORA A
RAR
MOV B,A
ORA A
RET
ENDFUNC
;
; LDB2---AS LDB1, BUT RETURNS TO CALLER'S CALLER ON LENGTH ZERO.
;
FUNCTION LDB2
EXTERNAL LDB1,ABRT
CALL LDB1
JZ ABRT
RET
ENDFUNC
;
; LDC1---LOADS REGISTER C WITH LENGTH INDICATOR OF MULTI-VALUE AT (HL).
;
FUNCTION LDC1
MOV A,M
RAL
ORA A
RAR
MOV C,A
ORA A
RET
ENDFUNC
;
; LDC2---AS LDC1, BUT RETURNS TO CALLER'S CALLER ON LENGTH ZERO.
;
FUNCTION LDC2
EXTERNAL LDC1,ABRT
CALL LDC1
JZ ABRT
RET
ENDFUNC
;
; ABRT---ABORT ROUTINE USED BY LDC2 AND LDB2. ADJUSTS STACK TO RETURN TO
; CALLER'S CALLER.
;
FUNCTION ABRT
INX SP
INX SP
RET
ENDFUNC
;
; OVFLW---OVERFLOW RECOVERY ROUTINE. CURRENTLY THIS ROUTINE PERFORMS
; AN UNCONDITIONAL RETURN TO CP/M WITH A JUMP TO LOCATION ZERO.
;
FUNCTION OVFLW
LXI D,OVER
MVI C,PSTRNG
CALL BDOS
JMP BASE
OVER: DB 'overflow error$'
ENDFUNC
;
; UNFLW---UNDERFLOW RECOVERY ROUTINE. CURRENTLY THIS ROUTINE PERFORMS
; AND UNCONDITIONAL RETURN TO CP/M WITH A JUMP TO LOCATION ZERO.
;
FUNCTION UNFLW
LXI D,UNDER
MVI C,PSTRNG
CALL BDOS
JMP BASE
UNDER: DB 'underflow error$'
ENDFUNC
;
; INRM---INCREMENT LENGTH INDICATOR OF VALUE AT (HL).
;
FUNCTION INRM
EXTERNAL OVFLW
MOV A,M
INR M
XRA M
RP ;CHECK FOR SIGN CHANGE
JMP OVFLW ;IF NEGATIVE, THEN SIZE LIMIT EXCEEDED.
ENDFUNC
;
; DCRM---DECREMENT LENGTH INDICATOR OF VALUE AT (DE).
;
FUNCTION DCRM
EXTERNAL UNFLW
MOV A,M
CPI 81H ;IS IT ZERO PLUS ONE?
JZ LABB
DCR M
RZ ;RETURN WITH ZERO SET FOR
;ZERO
XRA M ;SIGN CHANGE?
RP ;NO, ELSE
JMP UNFLW ;UNDERFLOW CONDITION HERE
LABB:
MVI M,0 ;SPECIAL CASE OF ZERO AS LENGTH AND
RET ;VALUE.
ENDFUNC
;
; INCR---ADD ONE TO (HL)
;
FUNCTION INCR
EXTERNAL LDC1,INCR2,INCR3
PUSH H
CALL LDC1 ;GET LENGTH
JZ INCR2
INCR1:
INX H
INR M ;INCREMENT DATA
JNZ INCR3 ;OVERFLOW?
DCR C
JNZ INCR1 ;LOOP TILL DONE
JMP INCR2
ENDFUNC
;
; INCR2---PART OF INCR
;
FUNCTION INCR2
EXTERNAL INRM
INCR2:
INX H
MVI M,1 ;EXTEND PRECISION
POP H
CALL INRM ;EXTEND LENGTH
RET
ENDFUNC
;
; INCR3---PART OF INCR
;
FUNCTION INCR3
POP H
RET
ENDFUNC
;
; DECR---SUBTRACT ONE FROM (HL).
;
FUNCTION DECR
EXTERNAL INCR,LDC2,MOOV,DCRM
MOV A,M
ORA A
JZ DECR3
ANI 80H
JNZ INCR
PUSH H
CALL LDC2
INX H
MOV A,M
SBI 1
MOV M,A
DCR C
JZ DECR2
DECR1:
INX H
MOV A,M
SBI 0
MOV M,A
DCR C
JNZ DECR1
DECR2:
POP H
ORA A
RNZ
CALL DCRM
RET
DECR3:
MVI M,81H
INX H
MVI M,1
DCX H
RET
ENDFUNC
;
; LEFT---SHIFT (HL) LEFT ONE BIT, MULTIPLY BY 2.
;
FUNCTION LEFT
EXTERNAL LDC2,INCR2
CALL LDC2
PUSH H
LEFT1:
INX H
MOV A,M ;GET BYTE
RAL
MOV M,A ;RESTORE SHIFTED
DCR C ;DECREMENT COUNTER
JNZ LEFT1
JC INCR2 ;EXTEND PRECISION IF OVERFLOW OFF END
POP H
RET
ENDFUNC
;
; RIGHT---SHIFT (HL) RIGHT ONE BIT, DIVIDE BY 2.
;
FUNCTION RIGHT
EXTERNAL LDC2,DCRM
CALL LDC2
MVI B,0
DAD B ;GO TO TO HIGH END
MOV A,M
RAR
MOV M,A ;ROTATE RIGHT
MOV B,A ;SAVE NEW TOP BYTE
RIGHT1:
DCX H
DCR C
JZ RIGHT2
MOV A,M
RAR
MOV M,A
JMP RIGHT1 ;HANDLE REST OF DATA
RIGHT2:
DCR B ;WAS NEW TOP EQUAL TO ZERO?
RP ;NO.
PUSH PSW ;IF YES, THEN SAVE CARRY (= LOST BIT)
CALL DCRM ;CHANGE LENGTH
POP PSW
RET
ENDFUNC
;
; MOOV---MOVE VALUE FROM (DE) TO (HL)
;
FUNCTION MOOV
EXTERNAL LDB1
CALL LDB1
MOV M,A
RZ ;WAS LENGTH EQUAL TO ZERO?
LDAX D ;NO, THEN MOVE THINGS
MOV M,A ;STORE PROPER LENGTH COUNT
PUSH D
PUSH H ;SAVE POINTERS
MOOV1:
INX D
INX H
LDAX D
MOV M,A
DCR B
JNZ MOOV1
POP H
POP D
RET
ENDFUNC
;
; PARE---COMPARE TWO MULTI-BYTE VALUES (DE) TO (HL).
; RETURNS ZERO SET IF EQUAL, CARRY SET IF (DE)<(HL).
;
FUNCTION PARE
EXTERNAL LDC1
MOV A,M
RAL ;SIGN TO CARRY
CMC ;SET TO TRUE
RAR ;PUT IT BACK
MOV B,A
LDAX D
RAL ;SAME TO (DE)
CMC
RAR
CMP B ;COMPARE LENGTHS
RNZ ;LENGTHS NOT EQUAL
CALL LDC1 ;GET LENGTH OF (HL)
PUSH H
PUSH D
MVI B,0
DAD B ;POINT TO HIGH BYTE OF (HL)
XCHG
DAD B ;POINT TO HIGH BYTE OF (DE)
XCHG
PARE1:
LDAX D
CMP M ;COMPARE BYTES
JNZ PARE2 ;NOT EQUAL
DCX H
DCX D ;TRY NEXT BYTE DOWN
DCR C
JNZ PARE1
PARE2:
POP D
POP H
RET
ENDFUNC
;
; PSHL---DEQUEUE UTILITY, PUSH VALUE TO BEGINING OF (HL).
;
FUNCTION PSHL
EXTERNAL OVFLW
PUSH PSW ;SAVE VALUE
MVI B,0
MOV A,M ;GET LENGTH
ORA A
MOV C,A ;MOVE LENGTH TO C AS A COUNTER
JZ PSHL2 ;IF ZERO, NO NEED TO SHUFFLE DATA AROUND
DAD B ;GOTO HIGH END OF DATA
PSHL1:
MOV A,M
INX H
MOV M,A
DCX H
DCX H
DCR C
JNZ PSHL1
PSHL2:
INR M ;ADVANCE LENGTH
JZ OVFLW ;OVERFLOW CONDITION
POP PSW
INX H
MOV M,A ;PUT NEW BYTE AWAY
DCX H
RET
ENDFUNC
;
; POPL---DEQUEUE UTILITY, POP FROM BEGINING OF (HL).
;
FUNCTION POPL
MOV A,M ;GET LENGTH
ORA A
RZ ;NOTHING TO GET
MOV C,A
PUSH H
INX H
MOV B,M ;GET DATA BYTE
POPL1:
INX H
MOV A,M
DCX H
MOV M,A
INX H
DCR C
JNZ POPL1
POP H
DCR M ;LENGTH EQUALS LENGTH MINUS ONE
MOV A,B ;DATA REMOVED TO ACCUMULATOR
RET
ENDFUNC
;
; PSHH---DEQUEUE UTILITY, PUSH DATA ONTO END OF (HL).
;
FUNCTION PSHH
EXTERNAL OVFLW
PUSH H
PUSH PSW ;SAVE DATA BYTE AND LENGTH BYTE
INR M ;EXTEND LENGTH
JZ OVFLW ;OVERFLOW CONDITION
MOV C,M ;LENGTH
MVI B,0
DAD B ;GOTO HIGH END OF DATA
POP PSW
MOV M,A ;PUT DATA IN POSITION
POP H
RET
ENDFUNC
;
; POPH---DEQUEUE UTILITY, POP DATA FROM END OF (HL).
;
FUNCTION POPH
MOV A,M ;LENGTH
ORA A
RZ ;NOTHING TO GET
MOV C,A
PUSH H
MVI B,0
DAD B ;GOTO HIGH END OF DATA
MOV A,M ;GET BYTE
POP H
PUSH PSW ;SAVE IT
DCR M ;LENGTH EQUALS LENGTH MINUS ONE
POP PSW
RET
ENDFUNC
;
; DECTOHEX---GIVEN A STRING AT (HL) IN STANDARD FORM,
; N BYTES, FOLLOWED BY A NULL CHAR, CONVERT TO HEX NUMBER
; IN VERY LONG INTEGER FORMAT AT (DE).
;
FUNCTION DECTOHEX
EXTERNAL MULT,AD1
XRA A
STAX D
STA NFLAG
MOV A,M
CPI '-'
JNZ DTH11
MVI A,1
STA NFLAG
INX H
DTH1:
MOV A,M
DTH11:
ANI 0FH
ORA A
JZ DTH2 ;SKIP IF DIGIT IS ZERO
STA DIGIT+1
PUSH H
LXI H,DIGIT
CALL AD1
POP H
DTH2:
INX H ;GET NEXT DIGIT IF ANY
MOV A,M
ORA A ;IS IT A NULL?
JZ DTH3 ;YES, THEN FINISHED
PUSH H
LXI H,TEN
CALL MULT ;SHIFT TO NEXT DIGIT POSITION
POP H
JMP DTH1
DTH3:
LDA NFLAG
ORA A
RZ
LDAX D
ORI 80H
STAX D
RET
TEN: DB 1,10
DIGIT: DB 1,0
NFLAG: DB 0
ENDFUNC
;
; HEXTODEC---CONVERT HEX NUMBER IN VERY LONG INTEGER FORMAT
; AT (DE) TO A DECIMAL NUMBER (STRING), RETURN ADDRESS IN HL.
; FOR MORE INFORMATION ON RADIX CONVERSION SEE KNUTH, VOL 2,
; "SEMINUMERICAL ALGORITHMS" PP 302-310.
;
FUNCTION HEXTODEC
EXTERNAL MODULUS,MOOV
EXP: EQU 12 ;FOR RADIX 10^12 CONVERSION
LDAX D
CPI 80H
JZ HTD0 ;HANDLE CASE OF "-0"
ORA A
JNZ HTD1 ;HANDLE CASE OF "0"
HTD0:
LXI H,ANSWER
MVI M,30H
INX H
MVI M,0
DCX H
RET
HTD1:
XRA A
STA NFLAG
LXI H,INDEX
SHLD INDEXPTR
LXI H,TEMPARRAY
SHLD TEMPPTR
LXI H,ANSEND
SHLD ANSPTR
LDAX D
ORA A
JP HTD2
MVI A,'-' ;NUMBER IS NEGATIVE
STA NFLAG
HTD2:
LXI H,RADIX
CALL MODULUS
CALL HTD14 ;MOVE RESULT TO T2
JC HTD3
LHLD TEMPPTR
CALL MOOV
PUSH D
XCHG
LHLD INDEXPTR
MOV M,E
INX H
MOV M,D
INX H
SHLD INDEXPTR
XCHG
POP D
LDAX D
MOV C,A
MVI B,0
DAD B
INX H
SHLD TEMPPTR
XCHG
LXI D,T2
CALL MOOV
XCHG
JMP HTD2
HTD3:
LHLD TEMPPTR
CALL MOOV
XCHG
LHLD INDEXPTR
MOV M,E
INX H
MOV M,D
INX H
MVI M,0
INX H
MVI M,0
HTD4:
LXI H,INDEX
SHLD INDEXPTR
HTD5:
LHLD INDEXPTR
MOV E,M
INX H
MOV A,M
ORA E
JZ HTD9
MOV D,M
INX H
SHLD INDEXPTR
LXI H,TEMP
CALL MOOV
LDA TEMP
ORA A
JZ HTD7
HTD6:
MVI A,EXP
STA RCNT
HTD61:
LXI D,TEMP
LXI H,TEN
LDAX D
ORA A
JZ HTD62
CALL MODULUS
CALL HTD14 ;MOVE RESULT TO T2
INX D
LDAX D
DCX D
CALL HTD13
LDA RCNT
DCR A
JZ HTD5
STA RCNT
XCHG
LXI D,T2
CALL MOOV
XCHG
JMP HTD61
HTD62:
LDA RCNT
ORA A
JZ HTD5
DCR A
STA RCNT
MVI A,0
CALL HTD13
JMP HTD62
HTD7:
MVI B,EXP
HTD8:
MVI A,0
CALL HTD13
DCR B
JNZ HTD8
JMP HTD5
HTD9:
LHLD ANSPTR
HTD10:
INX H
MOV A,M
CPI 30H
JZ HTD10
LDA NFLAG
ORA A
RZ
DCX H
MOV M,A
RET
HTD13:
PUSH H
LHLD ANSPTR
ADI 30H
MOV M,A
DCX H
SHLD ANSPTR
POP H
RET
HTD14:
PUSH PSW
PUSH H
PUSH D
LXI D,T2
XCHG ;MOVE QUOTIENT TO T2
CALL MOOV
POP D
POP H
POP PSW
RET
RCNT: DB 0
T2: DS 128
NFLAG: DB 0
DIGIT: DB 1,0
TEN: DB 1,10
RADIX: DB 05,00
DB 10H,0A5H,0D4H,0E8H
INDEXPTR: DW 0
TEMPPTR: DW 0
ANSPTR: DW 0
INDEX: DS 128
TEMP: DS 128
TEMPARRAY: DS 512
ANSWER: DS 320
ANSEND: DS 1
DB 0 ;NULL TERMINATOR.
ENDFUNC
END